home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / Peter Lewis (TCPExample) / PNL Libraries / TCPUtils.p < prev   
Encoding:
Text File  |  1995-12-11  |  9.7 KB  |  359 lines  |  [TEXT/CWIE]
  1. unit TCPUtils;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, TCPTypes;
  7.         
  8.     var
  9.         mactcp_driver_refnum:integer;
  10.  
  11.     type
  12.         TCPXControlBlock = record
  13.                 completion: ProcPtr;
  14.                 pb: TCPControlBlock;
  15.             end;
  16.         TCPXControlBlockPtr = ^TCPXControlBlock;
  17.  
  18.         TCPStateType = (T_WaitingForOpen, T_Dead, T_Bored, T_Opening, T_Established,
  19.             T_Closing, T_PleaseClose, T_Unknown);
  20. { T_Bored means listening or closed }
  21.  
  22.     type
  23.         DNRCompletionProcPtr = ProcPtr;
  24. { procedure DNRCompletionProc(drp:DNRRecordPtr); }
  25.         DNRRecord = record
  26. { Generally you only need to look at the first three of these }
  27.                 ioResult: OSErr;
  28.                 name: Str255;
  29.                 addr: longint;
  30.                 completion: DNRCompletionProcPtr;
  31.                 case integer of
  32.                     1: (
  33.                             hi: hostInfo;
  34.                     );
  35.                     2: (
  36.                             hmx: hmxInfoRec;
  37.                     );
  38.                     3: (
  39.                             cacherec: cacheEntryRecord;
  40.                     );
  41.             end;
  42.         DNRRecordPtr = ^DNRRecord;
  43.  
  44.     procedure StartupTCPUtils;
  45.     
  46.     function MTTCPCreate(var stream:StreamPtr; buffer:Ptr; buffer_size:longint):OSErr;
  47.     function MTTCPRelease(var stream:StreamPtr):OSErr;
  48.     function MTTCPActiveOpen(var cb:TCPControlBlock; stream:StreamPtr; local_port: integer; remote_ip: longint; remote_port: integer):OSErr;
  49.     function MTTCPPassiveOpen(var cb:TCPControlBlock; stream:StreamPtr; var local_port: integer):OSErr;
  50.     function MTTCPClose(var cb:TCPControlBlock; stream:StreamPtr):OSErr;
  51.     function MTTCPAbort(stream:StreamPtr):OSErr;
  52.     function MTTCPState(stream:StreamPtr):TCPStateType;
  53.  
  54.     function MTUDPCreate(var stream:StreamPtr; var localport: integer; outstanding_count_ptr: LongIntPtr; buffer:Ptr; buffer_size:longint):OSErr;
  55.     function MTUDPRelease (stream:StreamPtr): OSErr;
  56.     function MTUDPRead (stream:StreamPtr; outstanding_count_ptr: LongIntPtr; var remoteIP: longint; var remoteport: integer;
  57.                                     var datap: ptr; var datalen: integer): OSErr;
  58.     function MTUDPReturnBuffer (stream:StreamPtr; datap: ptr): OSErr;
  59.     function MTUDPWrite (stream:StreamPtr; remoteIP: longint; remoteport: integer;
  60.                                     datap: ptr; datalen: integer; checksum: boolean): OSErr;
  61.  
  62.     procedure SanitizeHostName (var s: Str255);
  63.  
  64.     procedure DNRNameToAddr (name: Str255; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  65.     procedure DNRAddrToName (addr: longint; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  66.  
  67.     procedure MTZeroTCPCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
  68.     procedure MTZeroUDPCB (var cb: UDPControlBlock; stream: StreamPtr; call: integer);
  69.  
  70. implementation
  71.     
  72.     uses
  73.         Devices, Memory, 
  74.         MyCStrings, MyCallProc, DNR, MyMemory, MyStartup;
  75.         
  76.     var
  77.         gDNRNameToAddrCompletionProc:UniversalProcPtr;
  78.         gDNRAddrToNameCompletionProc:UniversalProcPtr;
  79.         gUDPNotifyProc:UniversalProcPtr;
  80.         
  81.     procedure MTZeroTCPCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
  82.     begin
  83.         MZero(@cb, SizeOf(cb));
  84.         cb.tcpStream := stream;
  85.         cb.ioCRefNum := mactcp_driver_refnum;
  86.         cb.csCode := call;
  87.     end;
  88.  
  89.     procedure MTZeroUDPCB (var cb: UDPControlBlock; stream: StreamPtr; call: integer);
  90.     begin
  91.         MZero(@cb, SizeOf(cb));
  92.         cb.udpStream := stream;
  93.         cb.ioCRefNum := mactcp_driver_refnum;
  94.         cb.csCode := call;
  95.     end;
  96.  
  97.     function MTTCPCreate(var stream:StreamPtr; buffer:Ptr; buffer_size:longint):OSErr;
  98.         var
  99.             err:OSErr;
  100.             cb:TCPControlBlock;
  101.     begin
  102.         MTZeroTCPCB(cb, nil, TCPcsCreate);
  103.         cb.create.rcvBuff := buffer;
  104.         cb.create.rcvBuffLen := buffer_size;
  105.         err := PBControlSync(@cb);
  106.         if err = noErr then begin
  107.             stream := cb.tcpStream;
  108.         end else begin
  109.             stream := nil;
  110.         end;
  111.         MTTCPCreate := err;
  112.     end;
  113.     
  114.     function MTTCPRelease(var stream:StreamPtr):OSErr;
  115.         var
  116.             cb:TCPControlBlock;
  117.     begin
  118.         MTZeroTCPCB(cb, stream, TCPcsRelease);
  119.         MTTCPRelease := PBControlSync(@cb);
  120.         stream := nil;
  121.     end;
  122.  
  123.     function MTTCPActiveOpen(var cb:TCPControlBlock; stream:StreamPtr; local_port: integer; remote_ip: longint; remote_port: integer):OSErr;
  124.     begin
  125.         MTZeroTCPCB(cb, stream, TCPcsActiveOpen);
  126.         cb.open.localPort := local_port;
  127.         cb.open.remoteHost := remote_ip;
  128.         cb.open.remotePort := remote_port;
  129.         cb.open.ulpTimeoutAction := -1;
  130.         MTTCPActiveOpen := PBControlAsync(@cb);
  131.     end;
  132.  
  133.     function MTTCPPassiveOpen(var cb:TCPControlBlock; stream:StreamPtr; var local_port: integer):OSErr;
  134.         var
  135.             err:OSErr;
  136.     begin
  137.         MTZeroTCPCB(cb, stream, TCPcsPassiveOpen);
  138.         cb.open.localPort := local_port;
  139.         cb.open.ulpTimeoutAction := -1;
  140.         err := PBControlAsync(@cb);
  141.         if err = noErr then begin
  142.             while (cb.ioResult>=0) & (cb.open.localPort=0) do begin
  143.                 ;
  144.             end;
  145.             local_port:=cb.open.localPort;
  146.         end;
  147.         MTTCPPassiveOpen := err;
  148.     end;
  149.     
  150.     function MTTCPClose(var cb:TCPControlBlock; stream:StreamPtr):OSErr;
  151.     begin
  152.         MTZeroTCPCB(cb, stream, TCPcsClose);
  153.         MTTCPClose := PBControlAsync(@cb);
  154.     end;
  155.  
  156.     function MTTCPAbort(stream:StreamPtr):OSErr;
  157.         var
  158.             cb:TCPControlBlock;
  159.     begin
  160.         MTZeroTCPCB(cb, stream, TCPcsAbort);
  161.         MTTCPAbort := PBControlSync(@cb);
  162.     end;
  163.  
  164.     function MTTCPState(stream:StreamPtr):TCPStateType;
  165.         var
  166.             err:OSErr;
  167.             cb:TCPControlBlock;
  168.     begin
  169.         MTZeroTCPCB(cb, stream, TCPcsStatus);
  170.         err := PBControlSync(@cb);
  171.         MTTCPState := T_Dead;
  172.         if err = noErr then begin
  173.             case cb.status.connectionState of
  174.                 0: 
  175.                     MTTCPState := T_Dead;
  176.                 2: 
  177.                     MTTCPState := T_Bored;
  178.                 4, 6: 
  179.                     MTTCPState := T_Opening;
  180.                 8: 
  181.                     MTTCPState := T_Established;
  182.                 10, 12, 16, 18, 20: 
  183.                     MTTCPState := T_Closing;
  184.                 14: 
  185.                     MTTCPState := T_PleaseClose;
  186.                 otherwise begin
  187.                     MTTCPState := T_Unknown;
  188.                 end;
  189.             end;
  190.         end;
  191.     end;
  192.     
  193.     procedure SanitizeHostName (var s: Str255);
  194.     begin
  195.         C2P(@s);
  196.         if s[Length(s)] = '.' then begin
  197.             s[0] := chr(Length(s) - 1);
  198.         end;
  199.     end;
  200.  
  201.     procedure DNRNameToAddrCompletion (hip: hostInfoPtr; drp: DNRRecordPtr);
  202.     begin
  203.         drp^.ioResult := hip^.rtnCode;
  204.         drp^.addr := drp^.hi.addrs[1];
  205.         if drp^.completion <> nil then begin
  206.             CallPascal04(drp, drp^.completion);
  207.         end;
  208.     end;
  209.  
  210.     procedure DNRNameToAddr (name: Str255; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  211.         var
  212.             err: OSErr;
  213.     begin
  214.         drp^.ioResult := 1;
  215.         drp^.name := name;
  216.         drp^.completion := completion;
  217.         err := StrToAddr(name, drp^.hi, gDNRNameToAddrCompletionProc, ptr(drp));
  218.         if err <> cacheFaultErr then begin
  219.             drp^.hi.rtnCode := err;
  220.             DNRNameToAddrCompletion(@drp^.hi, drp);
  221.         end;
  222.     end;
  223.  
  224.     procedure DNRAddrToNameCompletion (hip: hostInfoPtr; drp: DNRRecordPtr);
  225.     begin
  226.         drp^.ioResult := hip^.rtnCode;
  227.         if drp^.ioResult = noErr then begin
  228.             BlockMoveData(@hip^.rtnHostName, @drp^.name, SizeOf(drp^.name));
  229.             SanitizeHostName(drp^.name);
  230.         end;
  231.         if drp^.completion <> nil then begin
  232.             CallPascal04(drp, drp^.completion);
  233.         end;
  234.     end;
  235.  
  236.     procedure DNRAddrToName (addr: longint; drp: DNRRecordPtr; completion: DNRCompletionProcPtr);
  237.         var
  238.             err: OSErr;
  239.     begin
  240.         drp^.ioResult := 1;
  241.         drp^.addr := addr;
  242.         drp^.completion := completion;
  243.         AddrToStr(addr, drp^.name);
  244.         err := AddrToName(addr, drp^.hi, gDNRAddrToNameCompletionProc, ptr(drp));
  245.         if err <> cacheFaultErr then begin
  246.             drp^.hi.rtnCode := err;
  247.             DNRAddrToNameCompletion(@drp^.hi, drp);
  248.         end;
  249.     end;
  250.  
  251.     procedure UDPNotify (stream: streamPtr; eventCode: integer; outstanding_count_ptr: LongIntPtr; icmpMsg: ptr);
  252.     begin
  253.         stream := stream; { Unused! }
  254.         icmpMsg := icmpMsg; { Unused! }
  255.         if eventCode = UDPDataArrival then begin
  256.             if outstanding_count_ptr <> nil then begin
  257.                 Inc(outstanding_count_ptr^);
  258.             end;
  259.         end;
  260.     end;
  261.  
  262.     function MTUDPCreate(var stream:StreamPtr; var localport: integer; outstanding_count_ptr: LongIntPtr; buffer:Ptr; buffer_size:longint):OSErr;
  263.         var
  264.             err: OSErr;
  265.             cb: UDPControlBlock;
  266.     begin
  267.         MTZeroUDPCB(cb, nil, UDPcsCreate);
  268.         if outstanding_count_ptr <> nil then begin
  269.             outstanding_count_ptr^ := 0;
  270.         end;
  271.         cb.create.rcvBuff := buffer;
  272.         cb.create.rcvBuffLen := buffer_size;
  273.         cb.create.notifyProc := gUDPNotifyProc;
  274.         cb.create.userDataPtr := Ptr(outstanding_count_ptr);
  275.         cb.create.localport := localport;
  276.         err := PBControlSync(@cb);
  277.         if err = noErr then begin
  278.             localport := cb.create.localport;
  279.             stream := cb.udpStream;
  280.         end else begin
  281.             stream := nil;
  282.         end;
  283.         MTUDPCreate := err;
  284.     end;
  285.  
  286.     function MTUDPRelease (stream:StreamPtr): OSErr;
  287.         var
  288.             err: OSErr;
  289.             cb: UDPControlBlock;
  290.     begin
  291.         MTZeroUDPCB(cb, stream, UDPcsRelease);
  292.         err := PBControlSync(@cb);
  293.         MTUDPRelease := err;
  294.     end;
  295.  
  296.     function MTUDPRead (stream:StreamPtr; outstanding_count_ptr: LongIntPtr; var remoteIP: longint; var remoteport: integer;
  297.                                     var datap: ptr; var datalen: integer): OSErr;
  298.         var
  299.             err: OSErr;
  300.             cb: UDPControlBlock;
  301.     begin
  302.         MTZeroUDPCB(cb, stream, UDPcsRead);
  303.         err := PBControlSync(@cb);
  304.         if (err = noErr) & (outstanding_count_ptr <> nil) then begin
  305.             Dec(outstanding_count_ptr^);
  306.         end;
  307.         remoteIP := cb.receive.remoteIP;
  308.         remoteport := cb.receive.remoteport;
  309.         datap := cb.receive.rcvBuff;
  310.         datalen := cb.receive.rcvBuffLen;
  311.         MTUDPRead := err;
  312.     end;
  313.  
  314.     function MTUDPReturnBuffer (stream:StreamPtr; datap: ptr): OSErr;
  315.         var
  316.             err: OSErr;
  317.             cb: UDPControlBlock;
  318.     begin
  319.         MTZeroUDPCB(cb, stream, UDPcsBfrReturn);
  320.         cb.return.rcvBuff := datap;
  321.         err := PBControlSync(@cb);
  322.         MTUDPReturnBuffer := err;
  323.     end;
  324.  
  325.     function MTUDPWrite (stream:StreamPtr; remoteIP: longint; remoteport: integer;
  326.                                     datap: ptr; datalen: integer; checksum: boolean): OSErr;
  327.         var
  328.             err: OSErr;
  329.             cb: UDPControlBlock;
  330.             wds: wdsType;
  331.     begin
  332.         MTZeroUDPCB(cb, stream, UDPcsWrite);
  333.         cb.send.remoteIP := remoteIP;
  334.         cb.send.remotePort := remoteport;
  335.         wds.size := datalen;
  336.         wds.buffer := datap;
  337.         wds.term := 0;
  338.         cb.send.wds := @wds;
  339.         cb.send.checksum := ord(checksum);
  340.         err := PBControlSync(@cb);
  341.         MTUDPWrite := err;
  342.     end;
  343.  
  344.     function InitTCPUtils(var msg: integer): OSStatus;
  345.     begin
  346.         msg := msg; { Unused }
  347.         gDNRNameToAddrCompletionProc := NewProc(@DNRNameToAddrCompletion,uppPascal044ProcInfo);
  348.         gDNRAddrToNameCompletionProc := NewProc(@DNRAddrToNameCompletion,uppPascal044ProcInfo);
  349.         gUDPNotifyProc := NewProc(@UDPNotify,uppPascal04244ProcInfo);
  350.         InitTCPUtils := noErr;
  351.     end;
  352.  
  353.     procedure StartupTCPUtils;
  354.     begin
  355.         SetStartup(InitTCPUtils, nil, 0, nil);
  356.     end;
  357.     
  358. end.
  359.